SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00011 TEXT WINDOWING ROUTINES 1 05-28-9314:08ALL SWAG SUPPORT TEAM Execute DOS in a Window IMPORT 78 F╔«ƒ {$A+,B-,D+,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}π{$M 16384,0,655360}πUnit ExecWin;πInterfaceπVar SaveInt10 : Pointer;ππProcedure ExecWindow(X1,Y1,X2,Y2,π Attr : Byte;π Path,CmdLine : String);ππImplementationπUsesπ Crt,Dos;πTypeπ PageType = Array [1..50,1..80] of Word;πVarπ Window : Recordπ X1,Y1,X2,Y2,π Attr : Byte;π CurX,CurY : Byte;π end;π Regs : Registers;π Cleared : Boolean;π Screen : ^PageType;π ActPage,π VideoMode : ^Byte;π {$ifOPT D+}π Fnc,π OldFnc : Byte;π {$endif}ππ{$ifOPT D+}πFunction FStr(Num : LongInt) : String;πVarπ Dummy : String;πbeginπ Str(Num,Dummy);π FStr := Dummy;πend;ππProcedure WriteXY(X,Y,Attr : Byte;TextStr : String);πVarπ Loop : Byte;πbeginπ if Length(TextStr)>0 thenπ beginπ Loop := 0;π Repeatπ Inc(Loop);π Screen^[Y,X+(Loop-1)] := ord(TextStr[Loop])+Word(Attr SHL 8);π Until Loop=Length(TextStr);π end;πend;π{$endif}ππProcedure ScrollUp(X1,Y1,X2,Y2,Attr : Byte); Assembler;πAsmπ mov ah,$06π mov al,$01π mov bh,Attrπ mov ch,Y1π mov cl,X1π mov dh,Y2π mov dl,X2π dec chπ dec clπ dec dhπ dec dlπ int $10πend;ππProcedure ClearXY(X1,Y1,X2,Y2,Attr : Byte); Assembler;πAsmπ mov ah,$06π mov al,$00π mov bh,Attrπ mov ch,Y1π mov cl,X1π mov dh,Y2π mov dl,X2π dec chπ dec clπ dec dhπ dec dlπ int $10πend;ππ{$ifOPT D+}πProcedure Beep(Freq,Delay1,Delay2 : Word);πbeginπ Sound(Freq);π Delay(Delay1);π NoSound;π Delay(Delay2);πend;π{$endif}ππ{$F+}πProcedure NewInt10(Flags,CS,IP,AX,BX,CX,π DX,SI,DI,DS,ES,BP : Word); Interrupt;πVarπ X, Y, X1,π Y1, X2, Y2 : Byte;π Loop, DummyW : Word;πbeginπ SetIntVec($10,SaveInt10);π {$ifOPT D+}π Fnc := Hi(AX);π if Fnc<>OldFnc thenπ beginπ WriteXY(1,1,14,'Coordinates:');π WriteXY(20,1,14,'Register:');π WriteXY(20,2,14,'AH: '+FStr(Hi(AX))+' ');π WriteXY(20,3,14,'AL: '+FStr(Lo(AX))+' ');π WriteXY(20,4,14,'BH: '+FStr(Hi(BX))+' ');π WriteXY(20,5,14,'BL: '+FStr(Lo(BX))+' ');π WriteXY(30,2,14,'CH: '+FStr(Hi(CX))+' ');π WriteXY(30,3,14,'CL: '+FStr(Lo(CX))+' ');π WriteXY(30,4,14,'DH: '+FStr(Hi(DX))+' ');π WriteXY(30,5,14,'DL: '+FStr(Lo(DX))+' ');π Case Fnc ofπ $0 : WriteXY(40,1,14,'Set video mode. ');π $1 : WriteXY(40,1,14,'Set cursor shape. ');π $2 : WriteXY(40,1,14,'Set cursor position. ');π $3 : WriteXY(40,1,14,'Get cursor position. ');π $4 : WriteXY(40,1,14,'Get lightpen position. ');π $5 : WriteXY(40,1,14,'Set active page. ');π $6 : WriteXY(40,1,14,'Scroll up lines. ');π $7 : WriteXY(40,1,14,'Scroll down lines. ');π $8 : WriteXY(40,1,14,'Get Character/attribute. ');π $9 : WriteXY(40,1,14,'Write Character/attribute. ');π $A : WriteXY(40,1,14,'Write Character. ');π $D : WriteXY(40,1,14,'Get pixel in Graphic mode. ');π $E : WriteXY(40,1,14,'Write Character. ');π $F : WriteXY(40,1,14,'Get video mode. ');π else WriteXY(40,1,14,'(unknown/ignored Function) ');π end;π Case Hi(AX) ofπ $0..$E : Beep(Hi(AX)*100,2,5);π else beginπ Beep(1000,50,0);π Repeat Until ReadKey<>#0;π end;π end;π end;π {$endif}π Case Hi(AX) ofπ $00 : beginπ ClearXY(Window.X1,Window.Y1,Window.X2,Window.Y2,Window.Attr);π GotoXY(Window.X1,Window.Y1);π Window.CurX := Window.X1;π Window.CurY := Window.Y1;π end;π $01 : beginπ Regs.AH := $01;π Regs.CX := CX;π Intr($10,Regs);π end;π $02 : beginπ X := Lo(DX);π Y := Hi(DX);π Window.CurX := X+1;π if Cleared thenπ beginπ Window.CurY := Window.Y1;π Cleared := False;π endπ else Window.CurY := Y+1;π if Window.CurX<=Window.X2 thenπ beginπ Regs.AH := $02;π Regs.BH := ActPage^;π Regs.DL := X;π Regs.DH := Y;π Intr($10,Regs);π end;π end;π $03 : beginπ Regs.AH := $03;π Regs.BH := ActPage^;π Intr($10,Regs);π DX := (Window.X1-Regs.DL)+((Window.Y1-Regs.DH) SHL 8);π CX := Regs.CX;π end;π $04 : AX := Lo(AX);π $06 : beginπ X1 := Window.X1+Lo(CX)-1;π Y1 := Window.Y1+Hi(CX)-1;π X2 := Window.X2+Lo(DX)-1;π Y2 := Window.Y2+Hi(DX)-1;π if Lo(AX)=0 thenπ beginπ ClearXY(Window.X1,Window.Y1,π Window.X2,Window.Y2,Window.Attr);π GotoXY(Window.X1,Window.Y1);π Window.CurX := Window.X1;π Window.CurY := Window.Y1;π Cleared := True;π endπ elseπ beginπ if X2>Window.X2 then X2 := Window.X2;π if Y2>Window.Y2 then Y2 := Window.Y2;π Regs.AH := $06;π Regs.AL := Lo(AX);π Regs.CL := X1;π Regs.CH := Y1;π Regs.DL := X2;π Regs.DH := Y2;π Regs.BH := Window.Attr;π Intr($10,Regs);π end;π end;π $07 : beginπ X1 := Window.X1+Lo(CX)-1;π Y1 := Window.Y1+Hi(CX)-1;π X2 := Window.X2+Lo(DX)-1;π Y2 := Window.Y2+Hi(DX)-1;π if X2>Window.X2 thenπ X2 := Window.X2;π if Y2>Window.Y2 thenπ Y2 := Window.Y2;π Regs.AH := $07;π Regs.AL := Lo(AX);π Regs.CL := X1;π Regs.CH := Y1;π Regs.DL := X2;π Regs.DH := Y2;π Regs.BH := Window.Attr;π Intr($10,Regs);π end;π $08 : beginπ Regs.AH := $08;π Regs.BH := ActPage^;π Intr($10,Regs);π AX := Regs.AX;π end;π $09,π $0A : beginπ Regs.AH := $09;π Regs.BH := ActPage^;π Regs.CX := CX;π Regs.AL := Lo(AX);π Regs.BL := Window.Attr;π Intr($10,Regs);π end;π $0D : AX := Hi(AX) SHL 8;π $0D : AX := Hi(AX) SHL 8;π $0E : beginπ Case Lo(AX) ofπ 7 : Write(#7);π 13 : beginπ Window.CurX := Window.X1-1;π if Window.CurY>=Window.Y2 thenπ beginπ Window.CurY := Window.Y2-1;π ScrollUp(Window.X1,Window.Y1,π Window.X2,Window.Y2,Window.Attr);π end;π end;π elseπ beginπ Regs.AH := $0E;π Regs.AL := Lo(AX);π Regs.BL := Window.Attr;π Intr($10,Regs);π end;π end;π Inc(Window.CurX);π GotoXY(Window.CurX,Window.CurY);π end;π $0F : beginπ AX := $03+(80 SHL 8);π BX := Lo(BX);π end;π elseπ beginπ Regs.AX := AX;π Regs.BX := BX;π Regs.CX := CX;π Regs.DX := DX;π Regs.SI := SI;π Regs.DI := DI;π Regs.DS := DS;π Regs.ES := ES;π Regs.BP := BP;π Regs.Flags := Flags;π Intr($10,Regs);π AX := Regs.AX;π BX := Regs.BX;π CX := Regs.CX;π DX := Regs.DX;π SI := Regs.SI;π DI := Regs.DI;π DS := Regs.DS;π ES := Regs.ES;π BP := Regs.BP;π Flags := Regs.Flags;π end;π end;π {$ifOPT D+}π if Fnc<>OldFnc thenπ beginπ WriteXY(1,2,14,FStr(Window.CurX)+':'+FStr(Window.CurY)+' ');π WriteXY(1,3,14,FStr(Window.CurX-Window.X1+1)+':'+π FStr(Window.CurY-Window.Y1+1)+' ');π WriteXY(40,2,14,'AH: '+FStr(Hi(AX))+' ');π WriteXY(40,3,14,'AL: '+FStr(Lo(AX))+' ');π WriteXY(40,4,14,'BH: '+FStr(Hi(BX))+' ');π WriteXY(40,5,14,'BL: '+FStr(Lo(BX))+' ');π WriteXY(50,2,14,'CH: '+FStr(Hi(CX))+' ');π WriteXY(50,3,14,'CL: '+FStr(Lo(CX))+' ');π WriteXY(50,4,14,'DH: '+FStr(Hi(DX))+' ');π WriteXY(50,5,14,'DL: '+FStr(Lo(DX))+' ');π OldFnc := Fnc;π end;π {$endif}π SetIntVec($10,@NewInt10);πend;π{$F-}ππProcedure ExecWindow;πbeginπ Window.X1 := X1;π Window.Y1 := Y1;π Window.X2 := X2;π Window.Y2 := Y2;π Window.Attr := Attr;π {$ifOPT D+}π Fnc := 255;π OldFnc := 255;π {$endif}π ClearXY(Window.X1,Window.Y1,π Window.X2,Window.Y2,Window.Attr);π GotoXY(Window.X1,Window.Y1);π Window.CurX := Window.X1;π Window.CurY := Window.Y1;π SwapVectors;π GetIntVec($10,SaveInt10);π SetIntVec($10,@NewInt10);π Exec(Path,CmdLine);π SetIntVec($10,SaveInt10);π SwapVectors;πend;ππbeginπ Window.X1 := Lo(WindMin);π Window.Y1 := Hi(WindMin);π Window.X2 := Lo(WindMax);π Window.Y2 := Hi(WindMax);π Window.Attr := TextAttr;π Window.CurX := WhereX;π Window.CurY := WhereY;π Cleared := False;π ActPage := Ptr(Seg0040,$0062);π VideoMode := Ptr(Seg0040,$0049);π if VideoMode^=7 thenπ Screen := Ptr(SegB000,$0000)π elseπ Screen := Ptr(SegB800,$0000);πend.π 2 05-28-9314:08ALL SWAG SUPPORT TEAM SHADOW1.PAS IMPORT 10 F╔ye {π> I Write the following Procedure to shadow Text behind a box. It worksπ> fine (so Far), but am not sure if there is a quicker, easier way.ππYou are searching through the video-RAM For the Char and Attr, you want toπchange. Perhaps, it is easier and faster to use the interrupt, that returnsπyou the Char under the Cursor , than you can change the attribute.π}πUsesπ Dos, Crt;ππProcedure Shadow(x1, y1, x2, y2 : Byte);πVarπ s, i, j : Byte;ππ Procedure Z(x, y : Byte);π Varπ r : Registers;π beginπ r.ah := $02;π { Function 2hex (Put Position of Cursor) }π r.bh := 0;π r.dh := y - 1; { Y-Position }π r.dl := x - 1; { X-Position }π intr($10,r);π r.ah := $08;π { Fkt. 8hex ( Read Char under cursor ) }π r.bh := 0;π intr($10, r);π Write(chr(r.al));π end;ππbeginπ s := TextAttr; { save Attr }π TextAttr := 8;π For i := y1 + 1 to y2 + 1 doπ For j := x1 + 1 to x2 + 1 doπ z(i, j);π TextAttr := s; { Attr back }πend;ππbeginπ Shadow(10,10,20,20);π ReadKey;πend. 3 05-28-9314:08ALL SWAG SUPPORT TEAM SHADOW2.PAS IMPORT 8 F╔┐∞ {πI Write the following Procedure to shadow Text behind a box. It worksπfine (so Far), but am not sure if there is a quicker, easier way.π}ππProcedure Shadow(x, y, xlength, ylength : Byte);πVarπ xshad,π yshad : Word;π i : Byte;πbeginπ xlength := xlength shl 1; { xlength * 2 }π xshad := ((x*2)+(y*160)-162) + ((ylength+1) * 160) + 4; { x coord }π yshad := ((x*2)+(y*160)-162) + (xlength); { y coord }π if Odd(Xshad) then Inc(XShad); { we want attr not Char }π if not Odd(YShad) then Inc(YShad); { " }π For i := 1 to xlength Doπ if Odd(i) thenπ Mem[$B800:xshad+i] := 8; { put x shadow }π For i := 1 to ylength Doπ beginπ Mem[$B800:yshad+(i*160)] := 8; { put y shadows }π Mem[$B800:yshad+2+(i*160)] := 8π endπend;π 4 05-28-9314:08ALL SWAG SUPPORT TEAM WINDOWS1.PAS IMPORT 38 F╔IO {π> Okay...it works fine, but I want to somehow be able to kindo of remove tπ> Window. I'm not sure if there is any way of doing this?ππYou need to save the screen data at the location you wish to makeπa Window, then after you're done With the Window simply restoreπthe screen data back to what it was. Here's some exampleπroutines of what you can do, you must call InitWindows once atπthe begining of the Program before using the OpenWindowπProcedure, then CloseWindow to restore the screen.π}ππUsesπ Crt;ππTypeπ ShadeType = (Shading, NoShading);π ScreenBlock = Array [1..2000] of Integer;π ScreenLine = Array [1..80] of Word;π ScreenArray = Array [1..25] of ScreenLine;π WindowLink = ^WindowControlBlock;π WindowControlBlock = Recordπ X,Y : Byte; { start position }π Hight : Byte; { Menu Hight }π Width : Byte; { Menu width }π ID : Byte; { Menu number }π BackLink : WindowLink; { previous block }π MenuItem : Byte; { select item }π ScreenData : ScreenBlock; { saved screen data }π end;π String30 = String[30];π ScreenPtr = ^ScreenRec;π ScreenRec = Array [1..25,1..80] of Integer;πππVarπ Screen : ScreenPtr;π ActiveWindow : Pointer;ππProcedure InitWindows;πbeginπ If LastMode = Mono Thenπ Screen := Ptr($B000,0)π Elseπ Screen := Ptr($B800,0);π ActiveWindow := Nil;πend;ππProcedure OpenWindow(X, Y, Lines, Columns, FrameColor,π ForeGround, BackGround : Byte;π Title : String30; Shade : ShadeType);πVarπ A, X1, X2,π Y1, Y2 : Integer;π OldAttr : Integer;π WindowSize : Integer;π Block : WindowLink;πbeginπ OldAttr := TextAttr;ππ WindowSize := (Lines + 3) * (Columns + 5) * 2 +π Sizeof(WindowControlBlock) - Sizeof(ScreenBlock);ππ If MemAvail < WindowSize Thenπ beginπ WriteLn;WriteLn('Program out of memory');π Halt;π end;ππ GetMem(Block,WindowSize);π Block^.X := X - 2;π Block^.Y := Y - 1;π Block^.Hight := Lines + 3;π Block^.Width := Columns + 5;π Block^.BackLink := ActiveWindow;ππ ActiveWindow := Block;π A := 1;π For Y1 := Block^.Y to Block^.Y+Block^.Hight-1 Doπ beginπ Move(Screen^[Y1, Block^.X], Block^.ScreenData[A], Block^.Width * 2);π A := A + Block^.Width;π end;ππ TextColor(FrameColor);π If BackGround = Black Thenπ TextBackGround(LightGray) { This will keep exploding Window visable }π Elseπ TextBackground(BackGround);ππ X1 := X + Columns Div 2;π X2 := X1 + 1;π Y1 := Y + Lines Div 2;π Y2 := Y1 + 1;ππ Repeatπ Window(X1, Y1, X2, Y2);π ClrScr;π If Columns < 20 Thenπ Delay(20);π If X1 > X Thenπ Dec(X1);π If X2 < X + Columns Thenπ Inc(X2);π If Y1 > Y Thenπ Dec(Y1);π If Y2 < Y + Lines Thenπ Inc(Y2);π Until (X2 - X1 >= Columns ) And (Y2 - Y1 >= Lines);ππ Window(X - 1, Y, X + Columns, Y + Lines);π TextBackground(BackGround);π ClrScr;π TextColor(FrameColor);π Window(1, 1, 80, 24);π GotoXY(X - 2, Y - 1);π Write('┌');π For A := 1 to Columns + 2 Doπ Write('─');ππ Write('┐');π For A := 1 to Lines Doπ beginπ GotoXY(X - 2, Y + A - 1);π Write('│');π GotoXY(X + Columns + 1, Y + A - 1);π Write('│');π end;π GotoXY(X - 2, Y + Lines);π Write('└');π For A := 1 to Columns + 2 Doπ Write('─');π Write('┘');π If Shade = Shading Thenπ beginπ For A := Y to Y + Lines + 1 Doπ Screen^[A, X + Columns + 2] := Screen^[A, X + Columns + 2] And $07FF;π For A := X - 1 to X + Columns + 1 Doπ Screen^[Y + Lines + 1, A] := Screen^[Y + Lines + 1, A] And $07FF;π end;π If Title <> '' Thenπ beginπ TextColor(FrameColor);π GotoXY(X + ((Columns - Length(Title)) div 2) - 1, Y - 1);π Write(' ', Title, ' ');π end;π Window(1, 1, 80, 24);πend;ππProcedure CloseWindow;πVarπ Block : WindowLink;π A : Integer;π Y1 : Integer;π WindowSize : Integer;πbeginπ If ActiveWindow = Nil Thenπ Exit;π Block := ActiveWindow;π WindowSize := (Block^.Hight) * (Block^.Width) * 2 +π Sizeof(WindowControlBlock) - Sizeof(ScreenBlock);π A := 1;π For Y1 := Block^.Y to Block^.Y+Block^.Hight - 1 Doπ beginπ Move(Block^.ScreenData[A], Screen^[Y1, Block^.X], Block^.Width * 2);π A := A + Block^.Width;π end;π ActiveWindow := Block^.BackLink;π FreeMem(Block, WindowSize);πend;ππbeginπ InitWindows;π OpenWindow(10, 5, 10, 50, LightGreen, LightBlue, Magenta,π 'Test Window', Shading);π ReadKey;π OpenWindow(20, 6, 6, 30, Green, Yellow, Blue,π 'Test Window 2', Shading);π ReadKey;π CloseWindow;π ReadKey;π CloseWindow;π ReadKey;π GotoXY(1,24);ππend.π 5 05-28-9314:08ALL SWAG SUPPORT TEAM WINDOWS2.PAS IMPORT 37 F╔E[ Uses Crt;ππTypeππ BufferType = Array[0..3999] of Byte; { screen size }π PtrBufferType = ^BufferType; { For dynamic use }ππVarπ Screen: BufferType Absolute $B800:$0; { direct access to }π { Text screen }ππFunction CharS(Len:Byte; C: Char): String;πVarπ S: String;πbegin { This Function returns a String of }π FillChar(S, Len+1, C); { Length Len and of Chars C. }π S[0] := Chr(Len);π CharS := S;πend;ππFunction Center(X1, X2: Byte; S: String): Byte;πVarπ L, Max: Integer;πbegin { This Function is used to center }π Max := (X2 - (X1-1)) div 2; { a String between two X coordinates. }π L := Length(S);π if Odd(L) then Inc(L);π Center := X1 + (Max - (L div 2));πend;πππProcedure DrawBox(X1, Y1, X2, Y2: Integer; Attr: Byte; Title: String);πVarπ L, Y, X: Integer;π S: String;ππbeginπ X := X2 - (X1-1); { find box width }π Y := Y2 - (Y1-1); { find box height }π { draw box }π S := Concat('╔', CharS(X-2, '═'), '╗');π GotoXY(X1, Y1);π TextAttr := Attr;π Write(S);π Title := Concat('╡ ', Title,' ╞');π GotoXY(Center(X1, X2, Title), Y1);π Write(Title);π For L := 2 to (Y-1) doπ beginπ GotoXY(X1, Y1+L-1);π Write('║', CharS(X-2, ' '), '║');π end;π GotoXY(X1, Y2);π Write('╚', CharS(X-2, '═'), '╝');ππend;ππProcedure SaveBox(X1, Y1, X2, Y2: Integer; Var BufPtr: PtrBufferType);πVarπ Poff, Soff, Y, XW, YW, Size: Integer;ππbeginπ XW := X2 - (X1 -1); { find box width }π YW := Y2 - (Y1 -1); { find box height }π Size := (XW*2 ) * YW; { size needed to store background }π GetMem(BufPtr, Size); { allocate memory to buffer }π For Y := 1 to YW do { copy line by line to buffer }π beginπ Soff := (((Y1-1) + (Y-1)) * 160) + ((X1-1)*2);π Poff := ((XW * 2) * (Y-1));π Move(Screen[Soff], BufPtr^[Poff], (XW * 2)); { Write to buffer }π end;πend;ππ(*************** end of PART 1 of 2. *****************************)π(****** PART 2 of 2 ********************************)πProcedure RestoreBox(X1, Y1, X2, Y2: Integer; Var BufPtr: PtrBufferType);πVarπ Poff, Soff, X, Y, XW, YW, Size: Integer;π F: File;ππbeginπ XW := X2 - (X1-1); { once again...find box width }π YW := Y2 - (Y1-1); { find height }π Size := (XW *2) * YW; { memory size to deallocate from buffer }π For Y := 1 to YW do { move back, line by line }π beginπ Soff := (( (Y1-1) + (Y-1)) * 160) + ((X1-1)*2);π Poff := ((XW*2) * (Y-1));π Move(BufPtr^[Poff], Screen[Soff], (XW*2));π end;π FreeMem(BufPtr, Size);πend;πππProcedure Shadow(X1, Y1, X2, Y2: Byte);πVarπ Equip: Byte Absolute $40:$10;π Vert, Height, offset: Integer;ππbeginπ if (Equip and 48) = 48 then Exit;ππ For Vert := (Y1+1) to (Y2+1) doπ For Height := (X2+1) to (X2+2) doπ beginπ offset := (Vert - 1) * 160 + (Height-1) * 2 + 1;π Screen[offset] := 8;π end;π Vert := Y2 + 1;π For Height := (X1+2) to (X2+2) doπ beginπ offset := (Vert-1) * 160 + (Height-1) * 2 + 1;π Screen[offset] := 8;π end;πend;ππProcedure Hello;πVarπ BufPtr: PtrBufferType;πbeginπ { note, that if you use shadow, save an xtra 2 columnsπ and 1 line to accomadate what Shadow does }π { V V }π SaveBox(7, 7, 73, 15, BufPtr);π DrawBox(7, 7, 71, 13, $4F, 'Hello');π Shadow(7, 7, 71, 13);π GotoXY(9, 9);π Write('Hello Terry! I hope this is what you were asking For.');π GotoXY(9, 11);π Write('Press Enter');π While ReadKey <> #13 do;π RestoreBox(7, 7, 73, 14, BufPtr);πend;ππProcedure Disclaimer;πVarπ BufPtr: PtrBufferType;πbeginπ SaveBox(5, 5, 77, 21, BufPtr);π DrawBox(5, 5, 75, 20, $1F, 'DISCLAIMER');π Shadow(5, 5, 75, 20);π Window(7, 7, 73, 19);π Writeln(' Seeing as I came up With these Procedures For');π Writeln('my own future Programs (I just recently wrote these)');π Writeln('please don''t Forget who wrote them originally if you');π Writeln('decide to use them in your own. Maybe a ''thanks to Eric Miller');π Writeln('For Window routines'' somewhere in your doCs?');π Writeln;π Writeln(' Also, if anyone can streamline this source, well, I''d');π Writeln('I''d like to see it...not that too much can be done.');π Writeln;π Writeln(' Eric Miller');π Window(1,1,80,25);π Hello;π TextAttr := $1F;π GotoXY(9, 18);π Writeln('Press Enter...');π While ReadKey <> #13 do;π RestoreBox(5, 5, 77, 21, BufPtr);πend;ππbeginπ TextAttr := $3F;π ClrScr;π Disclaimer;πend.π(***** end of PART 1 of 2 ******************************)π 6 05-28-9314:08ALL SWAG SUPPORT TEAM WINDOWS3.PAS IMPORT 17 F╔+₧ DS> Like say there is a Text Window that pops up when someone makes aπDS>choice. Then they select something else and a Text Window is made thatπDS>overlaps the previous one. Then I'd like to have it so if the userπDS>were to press, say, escape, the current Text Window would be "removed"πDS>and the old Window would still be there as is was....πDS>How can this be done?? Please keep in mind that I'm still sort ofππHere's two Procedures a friend of mine wrote (David Thomas: give creditπwhree credit is due). It works great With regular Text screens.πππPut This in you Type section:ππ WindowStatus = (OnScreen, OffScreen);π WindowType = Recordπ Point : Pointer;π Status : WindowStatus;π Col,π Row,π SaveAttr : Byte;π end;ππProcedure GetWindow (Var Name : WindowType);πVarπ Size,π endOffset,π StartOffset : Integer;πbegin { GetWindow }ππ With Name Doπ beginπ Col := WhereX;π Row := WhereY;π SaveAttr := TextAttr;ππ StartOffset := 0;π endOffset := 25 * 160;π Size := endOffset - StartOffset;π GetMem (Point, Size);ππ Move (Mem[$B800:StartOffset], Point^, Size);π Status := OnScreen;π end; { With }ππend; { GetWindow }π{--------------------------------------------------------------------}πProcedure PutWindow (Var Name : WindowType);πVarπ Size,π endOffset,π StartOffset : Integer;πbegin { PutWindow }ππ With Name Doπ beginπ StartOffset := 0;π endOffset := 25 * 160;π Size := endOffset - StartOffset;ππ Move (Point^, Mem[$B800:StartOffset], Size);ππ FreeMem (Point, Size);π Status := OffScreen;ππ TextAttr := SaveAttr;π GotoXY (Col, Row);π end; { With }ππend; { PutWindow }πππVery easy to use. Just declare a Varibale of WindowType, call theπGETWindow routine, then display whatever. When you're done, call theπPUTWindow routine and it Zap, it's back to how it was. Very face, veryπnice.π 7 05-28-9314:08ALL SALIM SAMAHA WINDOWS4.PAS IMPORT 10 F╔≈∞ { SALIM SAMAHA }ππUnit Windows;ππInterfaceππUsesπ Crt;ππConstπ Max = 3;ππTypeπ ScreenImage = Array [0..1999] of Word;π FrameRec = Recordπ Upperleft : Word;π LowerRight : Word;π ScreenMemory : ScreenImage;π end;ππVarπ SnapShot : ^ScreenImage;π FrameStore : Array [1..10] of ^FrameRec;π WindowNum : Byte;ππProcedure OpenWindow(UpLeftX, UpLeftY, LoRightX, LoRightY : Byte);πProcedure CloseWindow;ππImplementationππProcedure OpenWindow(UpLeftX, UpLeftY, LoRightX, LoRightY : Byte);πbeginπ SnapShot := Ptr( $B800, $0000);π Inc(WindowNum);π New(FrameStore[WindowNum]);π With Framestore[WindowNum]^ doπ beginπ ScreenMemory := SnapShot^;π UpperLeft := WindMin;π LowerRight := WindMax;π end;π Window(UpLeftX, UpLeftY, LoRightX, LoRightY);πend;ππProcedure CloseWindow;πbeginπ With Framestore[WindowNum]^ doπ beginπ Snapshot^ := ScreenMemory;π Window ((Lo(UpperLeft) + 1), (Hi(UpperLeft) + 1),π (Lo(LowerRight) + 1), (Hi(LowerRight) + 1));π end;π Dispose(Framestore[WindowNum]);π Dec(WindowNum);πend;ππ 8 08-27-9322:02ALL SEAN PALMER Moving Text Images IMPORT 12 F╔ {πSEAN PALMERππ>I was looking threw a Turbo C++ manual and noted someπ>Procedures that deal With the Text screen, such asπ>Get/PutTextImage. I was wondering if anyone has created oneπ>for Pascal to move/save Text images around the screen likeπ>in C++.ππCopies a rectangular section from one video buffer (any size) to anotherπ}ππProcedure moveScr(Var srcBuf; srcX, srcY, width, height, srcBufW,π srcBufH : Word; Var dstBuf; dstX, dstY, dstBufW,π dstBufH : Word); Assembler;πAsmπ cldπ push dsπ lds si, srcBuf {calc src adr}π mov ax, srcBufWπ mul srcYπ add ax, srcXπ shl ax, 1π add si, axπ les di, dstBuf {calc dst adr}π mov ax, dstBufWπ mul dstYπ add ax, dstXπ shl ax, 1π add di, axπ mov dx, height {num lines}π mov ax, SrcBufW {calc ofs between src lines}π sub ax, widthπ shl ax, 1π mov bx, dstBufW {calc ofs between dst lines}π sub bx, widthπ shl bx, 1π @L:π mov cx, widthπ rep movswπ add si, axπ add di, bxπ dec dxπ jnz @Lπ pop dsπend;ππVarπ s : Array [0..24,0..79,0..1] of Char Absolute $B800 : 0;π d : Array [0..11,0..39,0..1] of Char;π i : Integer;ππbeginπ For i := 1 to 25 * 10 doπ Write('(--)(--)');π moveScr(s,0,0,40,12,80,25,d,0,0,40,12); {copy 40x12 block to buf}π readln;π moveScr(d,0,0,38,10,40,12,s,5,5,80,25); {copy part back to screen}π readln;πend.ππ 9 11-02-9305:43ALL KELLY SMALL Get TextAttr Colors SWAG9311 4 F╔ {πKELLY SMALLππ>Get the foreground/background/blink attr out of TextAttr.ππAssuming you're using TP/BP:π}ππProcedure GetColor(Var f, b : Byte; Var BlinkOn : Boolean);πbeginπ f := TextAttr And $F;π b := (TextAttr Shr 4) And 7;π BlinkOn := TextAttr And $80 = $80;πend;π 10 11-02-9305:03ALL KIMBA DOUGHTY Shadow Boxes SWAG9311 18 F╔ { Updated SCREEN.SWG on November 2, 1993 }ππ{πKIMBA DOUGHTYππ> could someone tell me how to do a shadow Window.. you know the Type thatπ> has a Window then a shadow of what is under the Window in color 8 or darkπ> gray... Either in Inline assembly or Straight Pascal...π}ππUnit shadow;ππInterfaceππUsesπ Crt, Dos;ππProcedure WriteXY(X, Y : Integer; S : String);πFunction GetCharXY(X, Y : Integer) : Char;πProcedure SHADE(PX, PY, QX, QY : Integer);πProcedure BOX(PX, PY, QX, QY : Integer);πProcedure SHADOWBOX(PX, PY, QX, QY : Integer; fg, bg : Byte);ππImplementationππProcedure menubox(x1, y1, x2, y2 : Integer; fg, bg : Byte);πVarπ count : Integer;πbeginπ TextColor(fg);π TextBackGround(bg);π Writexy(x1 + 1, y1, '╔');ππ For count := x1 + 2 to x2 - 2 doπ Writexy(count, y1, '═');ππ Writexy(x2 - 1, y1, '╗');π For count := y1 + 1 to y2 - 1 doπ Writexy(x1 + 1, count, '║');ππ Writexy(x1 + 1, y2, '╚');π For count := y1 + 1 to y2 - 1 doπ Writexy(x2 - 1, count, '║');ππ Writexy(x2 - 1, y2, '╝');π For count := x1 + 2 to x2 - 2 doπ Writexy(count, y2, '═');πend;ππProcedure WriteXY(X, Y : Integer; S : String);πVarπ SX, SY : Integer ;πbeginπ SX := WhereX;π SY := WhereY;π GotoXY(X, Y);π Write(S);π GotoXY(SX, SY);πend;ππFunction GetCharXY(X, Y : Integer) : Char;πVarπ Regs : Registers;π SX, SY : Integer;πbeginπ SX := WhereX;π SY := WhereY;π GotoXY(X, Y);π Regs.AH := $08;π Regs.BH := $00;π Intr($10, Regs);π GetCharXY := Char(Regs.AL);π GotoXY(SX, SY);πend;ππProcedure SHADE(PX, PY, QX, QY : Integer);πVarπ X, Y : Integer;πbeginπ TextColor(8);π TextBackGround(black);π For Y := PY to QY Doπ For X := PX to QX Doπ WriteXY(X, Y, GetCharXY(X, Y));πend;ππProcedure BOX(PX, PY, QX, QY : Integer);πbeginπ Window(PX, PY, QX, QY);π ClrScr;πend;ππProcedure SHADOWBOX(PX, PY, QX, QY: Integer; fg, bg : Byte);πbeginπ TextColor(fg);π TextBackGround(bg);π BOX(PX, PY, QX, QY);π Window(1, 1, 80, 25);π SHADE(PX + 2, QY + 1, QX + 2, QY + 1);π SHADE(QX + 2, PY + 1, QX + 2, QY + 1);π SHADE(QX + 1, PY + 1, QX + 1, QY + 1);π MENUBOX(PX, PY, QX, QY, fg, bg);πend;ππend.ππ 11 11-21-9309:29ALL TIM SCHEMPP Text DrawLine Functions SWAG9311 63 F╔ { WRITTEN BY TIM SCHEMPPπ OCTOBER 21, 1993 }ππunit drawline;ππinterfaceππ procedure horizline(x1,x2,y:integer; default:char);π procedure vertline(x,y1,y2:integer; default:char);π procedure rectlines(x1,y1,x2,y2:integer; default:char);ππ{ IF writetomemory IS SET TO TRUE, LINES WILL BE DRAWN AN AVERAGE OFπ ABOUT 15 TO 20 PERCENT FASTER THAN IF writetomemory IS SET TO FALSE.π HOWEVER, IF DATA IS WRITTEN DIRECTLY TO VIDEO MEMORY, YOU ARE STUCK WITHπ THE SCREENS CURRENT COLORS (TEXTCOLOR AND TEXTBACKGROUND HAVE NO EFFECT).π THE DEFAULT VALUE OF writetomemory IS FALSE. }ππvar writetomemory:boolean;ππimplementationπ uses crt; {for gotoxy, wherex and wherey}ππ const symbols:array[1..40] of char=π ('│','┤','╡','╢','╖','╕','╣','║','╗','╝','╜','╛','┐',π '└','┴','┬','├','─','┼','╞','╟','╚','╔','╩','╦','╠',π '═','╬','╧','╨','╤','╥','╙','╘','╒','╓','╫','╪','┘',π '┌');ππ codes:array[1..40] of string[4]=π ('1010','1011','1012','2021','0021','0012','2022','2020',π '0022','2002','2001','1002','0011','1100','1101','0111',π '1110','0101','1111','1210','2120','2200','0220','2202',π '0222','2220','0202','2222','1202','2101','0212','0121',π '2100','1200','0210','0120','2121','1212','1001','0110');ππ {THE SCREEN DIMENSIONS}π screenwidth=80; screenlength=25;ππ{******}ππ{READS A CHARACTER FROM VIDEO MEMORY AT THE GIVEN COORDINANTS}πfunction Memread(col,row:integer):char;ππ Constπ Seg = $B000; { Video memory address for color system }π Ofs = $8000; { For monochrome system, make Ofs = $0000 }π Varπ SChar : Integer;π Beginπ SChar := ((Row-1)*160) + ((Col-1)*2); { Compute starting location }π memread:=chr(Mem[Seg:Ofs + SChar]); { read character from memory}π End;ππ{******}ππ{WRITES A CHARACTER DIRECTORY TO VIDEO MEMORY AT THE GIVEN COORDINATES}π{NOTE: THE CURRENT COLORS AT THE GIVEN COORDINANTS ARE USED FOR DRAWING.}πprocedure Memwrite(col,row:integer; c:char);ππ Constπ Seg = $B000; { Video memory address for color system }π Ofs = $8000; { For monochrome system, make Ofs = $0000 }π Varπ SChar : Integer;π Beginπ SChar := ((Row-1)*160) + ((Col-1)*2); { Compute starting location }π Mem[Seg:Ofs + SChar]:=ord(c); { write character to memory}π End;ππ{******}ππ {PROCEDURE USED INTERNALLY TO CREATE A SET OF CHARACTER CODES}π function getcode(c:char; direction:byte):char;π var counter:integer;π beginπ counter:=1;π while (counter<=40) and (c<>symbols[counter]) do inc(counter);π if counter>40 then getcode:='0' else getcode:=codes[counter,direction];π end;ππ{******}ππ {PROCEDURE DRAWS A LINE IN TEXT MODE FROM (X1,Y) TO (X2,Y)}π {DEFAULT IS EITHER '1' OR '2' FOR SINGLE OF DOUBLE LINES}π procedure horizline(x1,x2,y:integer; default:char);ππ var code:string[4];π defaultchar:char;π c,index:integer;π xpos,ypos:integer;ππ beginπ xpos:=wherex; ypos:=wherey;π if x2<x1 then begin c:=x1; x1:=x2; x2:=c; end;π if default='1' then defaultchar:=symbols[18]π else defaultchar:=symbols[27];π for c:=x1 to x2 doπ beginπ code:='0000';π if y<>0 then code[1]:=getcode(memread(c,y-1),3) else code[1]:='0';π if (c=x2) and (x2=screenwidth) then code[2]:='0'π else if (c=x2) then code[2]:=getcode(memread(x2+1,y),4)π else code[2]:=default;π if y<>screenlength then code[3]:=getcode(memread(c,y+1),1)π else code[3]:='0';π if (c=x1) and (x1=1) then code[4]:='0'π elseπ if (c=x1) then code[4]:=getcode(memread(x1-1,y),2)π else code[4]:=default;π index:=1;π while (index<=40) and (code<>codes[index]) do inc(index);π if writetomemory thenπ if index>40 then memwrite(c,y,defaultchar)π else memwrite(c,y,symbols[index])π elseπ if index>40 then begin gotoxy(c,y); write(defaultchar); endπ else begin gotoxy(c,y); write(symbols[index]); end;π end; {counter}π if not writetomemory then gotoxy(xpos,ypos);π end;ππ{******}ππ {PROCEDURE DRAWS A LINE IN TEXT MODE FROM (X,Y1) TO (X,Y2)}π {DEFAULT IS EITHER '1' OR '2' FOR SINGLE OF DOUBLE LINES}π procedure vertline(x,y1,y2:integer; default:char);ππ var code:string[4];π defaultchar:char;π c,index:integer;π xpos,ypos:integer;ππ beginπ xpos:=wherex; ypos:=wherey;π if y2<y1 then begin c:=y1; y1:=y2; y2:=c; end;π if default='1' then defaultchar:=symbols[1]π else defaultchar:=symbols[8];π for c:=y1 to y2 doπ beginπ code:='0000';π if (c=y2) and (y2=screenlength) then code[3]:='0'π else if (c=y2) then code[3]:=getcode(memread(x,y2+1),1)π else code[3]:=default;π if x<>screenwidth then code[2]:=getcode(memread(x+1,c),4)π else code[1]:='0';π if x<>1 then code[4]:=getcode(memread(x-1,c),2)π else code[1]:='0';π if (c=y1) and (y1=0) then code[1]:='0'π else if (c=y1) then code[1]:=getcode(memread(x,y1-1),3)π else code[1]:=default;π index:=1;π while (index<=40) and (code<>codes[index]) do inc(index);ππ if writetomemory thenπ if index>40 then memwrite(x,c,defaultchar)π else memwrite(x,c,symbols[index])π elseπ if index>40 then begin gotoxy(x,c); write(defaultchar) endπ else begin gotoxy(x,c); write(symbols[index]); end;π end; {counter}π if not writetomemory then gotoxy(xpos,ypos);π end;ππ{******}ππ {PROCEDURE DRAWS A RECTANGLE IN TEXT MODE}π {DEFAULT IS EITHER '1' OR '2' FOR SINGLE OF DOUBLE LINES}π procedure rectlines(x1,y1,x2,y2:integer; default:char);ππ beginπ horizline(x1,x2,y1,default);π horizline(x1,x2,y2,default);π vertline(x1,y1,y2,default);π vertline(x2,y1,y2,default);π end;ππ{******}ππ beginπ writetomemory:=false;π end. {unit}πππ {------------------- DEMO PROGRAM ------------------------}π { ---------------- CUT HERE --------------------------}ππ { WRITTEN BY TIM SCHEMPPπ OCTOBER 21, 1993 }ππ {THIS PROGRAM DEMONSTARTES THE USE OF THE UNIT drawline. UNIT DRAWLINEπ WILL USE THE ASCII SET TO DRAW LINES. WHEN LINE INTERSECTIONS AREπ FOUND, THE PROCEDURES DESCIDE WHICH CHARACTER FITS BEST. THUS MAKINGπ IT VERY EASY TO CREATE VARIOUS TABLES AND OTHER SCREEN SET UPS. THEπ UNIT ALSO HAS THE ABILITY TO WRITE DIRECTORY TO VIDEO MEMORY FORπ A 15% TO 20% IMPROVEMENT IN SPEED. SEE DRAWLINE.DOC FOR MORE INFO.}ππprogram demo;ππ uses crt,drawline;ππ var counter:integer;ππ beginπ {SET THE SCREEN UP}π textbackground(black);π textcolor(white);π clrscr;ππ {THE CALL TO CLEAR SCREEN FILLED THE SCREEN WITH SPACES WITH A BLACKπ BACKGROUND AND A WHITE FOREGROUND. IF writetomemory IS SET TO TRUE,π ALL OF THE OUTPUT WILL BE WRITTEN WITH A BLACK BACKGROUND AND A WHITEπ FOREGROUND REGARDLESS OF TEXT ATTRIBUTE CHANGES.}ππ {writetomemory:=true;} { <--- ADD THIS STATEMENT AND SEE COLOR DIFFERENCE}ππ {WRITE SOME TEXT}π gotoxy(22,6);π textcolor(lightblue);π write('LINE DRAWING DEMONSTARTATION PROGRAM');π textcolor(yellow);π {DRAW A RECTANGLE WITH DOUBLE LINES}π rectlines(10,4,70,20,'2');π {DRAW SOME HORIZONTAL SINGLE LINES}π for counter:=9 to 19 doπ horizline(10,70,counter,'1');π {DRAW SOME SINGLE VERTICLE LINES}π counter:=20;π while counter<=60 doπ beginπ vertline(counter,8,20,'1');π inc(counter,10);π end; {WHILE}π {DRAW ONE LAST HORIZONTAL DOUBLE LINE}π horizline(10,70,8,'2');ππ repeat until keypressed;π end.
